home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / dungeon / lightp.f < prev    next >
Encoding:
Text File  |  1987-09-16  |  2.4 KB  |  120 lines
  1. C LIGHTP-    LIGHT PROCESSOR
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     LOGICAL FUNCTION LIGHTP(OBJ)
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL QON
  12. #include "parser.h"
  13. #include "gamestate.h"
  14. #include "objects.h"
  15. #include "oflags.h"
  16. #include "oindex.h"
  17. #include "clock.h"
  18.  
  19. #include "verbs.h"
  20. #include "flags.h"
  21. C
  22. C FUNCTIONS AND DATA
  23. C
  24.     QON(R)=and(OFLAG1(R),ONBT).NE.0
  25. C LIGHTP, PAGE 2
  26. C
  27.     LIGHTP=.TRUE.
  28. C                        !ASSUME WINS
  29.     FLOBTS=FLAMBT+LITEBT+ONBT
  30.     IF(OBJ.NE.CANDL) GO TO 20000
  31. C                        !CANDLE?
  32.     IF(ORCAND.NE.0) GO TO 19100
  33. C                        !FIRST REF?
  34.     ORCAND=1
  35. C                        !YES, CANDLES ARE
  36.     CTICK(CEVCND)=50
  37. C                        !BURNING WHEN SEEN.
  38. C
  39. 19100    IF(PRSI.EQ.CANDL) GO TO 10
  40. C                        !IGNORE IND REFS.
  41.     IF(PRSA.NE.TRNOFW) GO TO 19200
  42. C                        !TURN OFF?
  43.     I=513
  44. C                        !ASSUME OFF.
  45.     IF(QON(CANDL)) I=514
  46. C                        !IF ON, DIFFERENT.
  47.     CFLAG(CEVCND)=.FALSE.
  48. C                        !DISABLE COUNTDOWN.
  49.     OFLAG1(CANDL)=and(OFLAG1(CANDL), not(ONBT))
  50.     CALL RSPEAK(I)
  51.     RETURN
  52. C
  53. 19200    IF((PRSA.NE.BURNW).AND.(PRSA.NE.TRNONW)) GO TO 10
  54.     IF(and(OFLAG1(CANDL),LITEBT).NE.0) GO TO 19300
  55.     CALL RSPEAK(515)
  56. C                        !CANDLES TOO SHORT.
  57.     RETURN
  58. C
  59. 19300    IF(PRSI.NE.0) GO TO 19400
  60. C                        !ANY FLAME?
  61.     CALL RSPEAK(516)
  62. C                        !NO, LOSE.
  63.     PRSWON=.FALSE.
  64.     RETURN
  65. C
  66. 19400    IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500
  67.     I=517
  68. C                        !ASSUME OFF.
  69.     IF(QON(CANDL)) I=518
  70. C                        !IF ON, JOKE.
  71.     OFLAG1(CANDL)=or(OFLAG1(CANDL),ONBT)
  72.     CFLAG(CEVCND)=.TRUE.
  73. C                        !RESUME COUNTDOWN.
  74.     CALL RSPEAK(I)
  75.     RETURN
  76. C
  77. 19500    IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600
  78.     IF(QON(CANDL)) GO TO 19700
  79. C                        !ALREADY ON?
  80.     CALL NEWSTA(CANDL,521,0,0,0)
  81. C                        !NO, VAPORIZE.
  82.     RETURN
  83. C
  84. 19600    CALL RSPEAK(519)
  85. C                        !CANT LIGHT WITH THAT.
  86.     RETURN
  87. C
  88. 19700    CALL RSPEAK(520)
  89. C                        !ALREADY ON.
  90.     RETURN
  91. C
  92. 20000    IF(OBJ.NE.MATCH) CALL BUG(6,OBJ)
  93.     IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500
  94.     IF(ORMTCH.NE.0) GO TO 20100
  95. C                        !ANY MATCHES LEFT?
  96.     CALL RSPEAK(183)
  97. C                        !NO, LOSE.
  98.     RETURN
  99. C
  100. 20100    ORMTCH=ORMTCH-1
  101. C                        !DECREMENT NO MATCHES.
  102.     OFLAG1(MATCH)=or(OFLAG1(MATCH),FLOBTS)
  103.     CTICK(CEVMAT)=2
  104. C                        !COUNTDOWN.
  105.     CALL RSPEAK(184)
  106.     RETURN
  107. C
  108. 20500    IF((PRSA.NE.TRNOFW).OR.(and(OFLAG1(MATCH),ONBT).EQ.0))
  109. &        GO TO 10
  110.     OFLAG1(MATCH)=and(OFLAG1(MATCH), not(FLOBTS))
  111.     CTICK(CEVMAT)=0
  112.     CALL RSPEAK(185)
  113.     RETURN
  114. C
  115. C HERE FOR FALSE RETURN
  116. C
  117. 10    LIGHTP=.FALSE.
  118.     RETURN
  119.     END
  120.